perm filename F8XX.F4[F8,ALS] blob
sn#307782 filedate 1977-10-04 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 $CONTROL USLINIT
C00068 ENDMK
Cā;
$CONTROL USLINIT
$CONTROL FILE=15,FILE=16
PROGRAM FMXREF
C
C
C
C
C
C
C
C
CCCC COMMON AREA
C
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1 ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,IRL,
2 IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,PWORD,
3 PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4 EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5 LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
C
C
CCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR, PSORT,PLINEAR,PSTACK,
1 P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,OPERANDTYPE,TERM,
2 BYTEPNTR,EXTNMBR, EXTCOUNT, RELTYPE, PRELATIVE,BYTE,EXT,EQU,
3 ORG,RMB,FCB,FDB,CMN,REL,UNDEFINED,EEQU,EEXT,RRMB,
4 HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3
C
INTEGER SYMBOLTABLE, SYMBOL, SFILE,OFILE,STACK,WORD,
1 MXSYMBOL(3),XTAB
C
C
C
CCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST, LISTSYMBOL, MEMORY, TAPE, FOUND, LISTON,
1 DIRECTIVE, EXTFOUND, RELFOUND, DEFERRED, ABSOLUTE, BEFOREREL,
2 EXTLIST, XREF, ABORTED,ITRAN
C
LOGICAL PASS2SW,DEFNSYMBOL
C
C
C
C
CCCCC EQUATE STATEMENT
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA ,LETAB(2)),(IBLKB ,LETAB( 3)),(IASTRIK,LETAB( 4)),
3 (ISPMA ,LETAB(5)),(ISPDIR,LETAB( 6)),(ISPEXT ,LETAB( 7)),
4 (ISPDIX ,LETAB(8)),(IPLUS ,LETAB( 9)),(ICOMMA ,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15))
C
EQUIVALENCE (ICOMAR,LETAB(19)),
1 (ICOMAT ,LETAB(20)),(ICOMAA,LETAB(21)),(ICOMAE ,LETAB(22)),
2 (ICOMAC ,LETAB(23)),(ICOMAK,LETAB(24)),(ILFAST ,LETAB(25))
C
DIMENSION ISYMBOL(3)
C
CALL INITIAL
C
WRITE(6,7010)
7010 FORMAT( / " MXREF PROGRAM RUNNING " / )
C
C
JDUMMY = 0
C
MAXTAB = 6000
DO 7100 I=1,MAXSYMBOLS
DO 7100 J=1,7
7100 SYMLTABLE(I,J) = 0
C
IN = 15
IPRINT = 16
C
DEFNSYMBOL = .FALSE.
LINECOUNT = 0
PSYMBOL = 0
LAST = 1
LINK = 1
PASS2SW = .FALSE.
C
C
8100 READ(IN,8110,END=8200,ERR=8950)(LINE(I),I=1,30)
8110 FORMAT(30A2)
C
LINECOUNT = LINECOUNT + 1
PCHAR = 1
C
JJ = ICHAR(1)
IF(JJ .EQ. IASTRIK) GO TO 8100
IF(JJ .EQ. IBLANK ) GO TO 8120
C
CALL IGETSYMBOL
CALL XADDTOSYMT (IERR)
C
8120 CALL INSTRT
C
GO TO 8100
C
CCCCCC XREF PASS2 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
C
8200 CONTINUE
REWIND IN
PASS2SW = .TRUE.
LINECOUNT = 0
C
CALL INITXTAB(IERR)
C
8210 READ(IN,8110,END=8500,ERR=8950)(LINE(I),I=1,30)
LINECOUNT = LINECOUNT + 1
C
PCHAR = 1
C
JJ = ICHAR(1)
IF(JJ .EQ. IASTRIK) GO TO 8210
IF(JJ .EQ. IBLANK ) GO TO 8230
C
CALL IGETSYMBOL
DEFNSYMBOL = .TRUE.
CALL XADDTOSYMT(IERR)
C
8230 CALL INSTRT
GO TO 8210
C
CCCCCC PRINT CROSS REF
C
C
8500 REWIND IN
C
C
CCCCCCC TEST ONLY
C
C IF(JDUMMY .EQ. 1) GO TO 8510
C
C STOP
C
8510 CTINUE
C
C
WRITE(IPRINT,8520)(SFILE(I),I=1,3)
8520 FORMAT(1H1,"SYMBOL TABLE XREF FOR ",3A2//1H ,
1 "ALPHABETIC ORDER "/ )
C
PSORT = 1
PLINEAR = 1
PSTACK = 1
C
CCCCCCC SEARCH LEFT
C
8530 J = SYMBOLTABLE(PSORT,5)
IF(J .EQ. 0) GO TO 8540
C
STACK(PSTACK) = PSORT
PSTACK = PSTACK + 1
PSORT = J
GO TO 8530
C
CCCCCCC CONTINUE LEFT
C
8540 I = SYMBOLTABLE(PSORT,4)
J = SYMBOLTABLE(PSORT+1,4)
J = J - 1
JK = I + 1
C
IF(I .NE. J) GO TO 8550
C
WRITE(IPRINT,8560)XTAB(I),(SYMBOLTABLE(PSORT,K),K=1,3)
GO TO 8570
C
C
8550 WRITE(IPRINT,8560)XTAB(I),(SYMBOLTABLE(PSORT,K),K=1,3),
1 (XTAB(K),K=JK,J)
8560 FORMAT(1X,I5,4X,3A2,6(4X,I5)/,99(16X,6(4X,I5) /,))
C
8570 PLINEAR = PLINEAR + 1
J = SYMBOLTABLE(PSORT,6)
IF(J .EQ. 0) GO TO 8600
C
STACK(PSTACK) = -PSORT
PSTACK = PSTACK + 1
PSORT = J
GO TO 8530
C
CCCCCCC CONTINUE RIGHT
C
8600 IF(PSTACK .EQ. 1) GO TO 8700
C
PSTACK = PSTACK - 1
PSORT = STACK(PSTACK)
IF(PSORT .GT. 0) GO TO 8540
PSORT = -PSORT
GO TO 8600
C
CCCCCC REWIND IN
C
8700 CONTINUE
C
WRITE(IPRINT,8720)
8720 FORMAT(" END MXREF "/1H1/1H1 )
RETURN
C
8950 WRITE(IPRINT,8960)LINECOUNT
8960 FORMAT("0 ####### ERROR READING INPUT FILE. ",
1 "LINE NUMBER = ", I5)
STOP
C
8900 WRITE(IPRINT,8910)
8910 FORMAT("0 ####### FIRST RECORD IS END OF FILE ######")
STOP
C
END
SUBROUTINE INITIAL
C
CCCCC INITIALIZATION
C
C
C
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1 ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,
1 TACK,IN,IRL,
2 IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,PWORD,
3 PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4 EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5 LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 JETAB(26),JTBLIB(62,5),JTYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
C
C
CCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR, PSORT,PLINEAR,
1 P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,OPERANDTYPE,TERM,
2 BYTEPNTR,EXTNMBR, EXTCOUNT, RELTYPE, PRELATIVE,BYTE,EXT,EQU,
3 HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,XTAB,PSTACK,
4 EXTLIST,BEFOREREL
C
C
INTEGER SYMBOLTABLE, SYMBOL,SFILE,OFILE,STACK,WORD,RMB
DIMENSION ITBLIB(62,5),ITYP1(2),LETAB(26)
C
C
CCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST, LISTSYMBOL, MEMORY,TAPE,FOUND,LISTON,
1 DIRECTIVE, EXTFOUND, RELFOUND, DEFERRED, ABSOLUTE, BEFORE
2 EXTLIST, XREF, ABORTED
LOGICAL PASS2SW,DEFNSYMBOL
C
C
C
C
CCCCC EQUATE STATEMENT
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA ,LETAB(2)),(IBLKB ,LETAB( 3)),(IASTRIK,LETAB(4)),
3 (ISPMA ,LETAB(5)),(ISPDIR,LETAB( 6)),(ISPEXT ,LETAB(7)),
4 (ISPDIX ,LETAB(8)),(IPLUS ,LETAB( 9)),(ICOM ,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15))
C
EQUIVALENCE (ICOMAR,LETAB(19)),
1 (ICOMAT ,LETAB(20)),(ICOMAA,LETAB(21)),(ICOMAE,LETAB(22)),
2 (ICOMAC ,LETAB(23)),(ICOMAK,LETAB(24)),(ILFAST,LETAB(25))
C
C
C
C
C
CCCC DATA
C (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
DATA LETAB/2H ,2H A,2H B,2H *,2H I,2H D,2H E,2H X,2H +,2H ,,
1 2H -,2H @,2H ',2H >,2H <,2HAS,2HMB,2H L,2H R,2H T,
2 2H A,2H E,2H C,2H K,2H* ,2H $/
C
C
C EQUATE LETAB( 1) = IBLANK , LETAB( 2) = IBLKA " "" A"
C " ( 3) = IBLKB , " ( 4) = IASTRIK " B"" *"
C " ( 5) = ISPMA , " ( 6) = ISPDIR " I"" D"
C " ( 7) = ISPEXT , " ( 8) = ISPIDX " E"" X"
C " ( 9) = IPLUS , " (10) = ICOMMA " +"" ,"
C " (11) = IMINUS , " (12) = IATAND " -"" @"
C " (13) = IAPOSTR , " (14) = IGREATR " '"" >"
C " (15) = ILESTN , " (16) = IASMB1 " <""AS"
C " (17) = IASMB2 , " (18) = ICOMAL "MB"",L"
C " (19) = ICOMAR , " (20) = ICOMAT ",R"",T"
C " (21) = ICOMAA , " (22) = ICOMAE ",A"",E"
C " (23) = ICOMAC , " (24) = ICOMAK ",C"",K"
C " (25) = ILFAST , " (26) = IDOLSN "* "" $"
C
C
C
CCCCC DATA FOR INSTRUCTIONS - ITBLIB(62,5)
C
C01 ADC TYPE = 2
DATA ITBLIB( 1,1)/2HAD/,ITBLIB( 1,2)/2HC /,ITBLIB( 1,3)/2H /,
1ITBLIB( 1,4)/2H /,ITBLIB( 1,5)/%2 /
C
C02 AI TYPE = 6
DATA ITBLIB( 2,1)/2HAI/,ITBLIB( 2,2)/2H /,ITBLIB( 2,3)/2H /,
1ITBLIB( 2,4)/2H /,ITBLIB( 2,5)/%6 /
C
C03 AM TYPE = 2
DATA ITBLIB( 3,1)/2HAM/,ITBLIB( 3,2)/2H /,ITBLIB( 3,3)/2H /,
1ITBLIB( 3)/2H /,ITBLIB( 3,5)/%2 /
C
C04 AMD TYPE = 2
DATA ITBLIB( 4,1)/2HAM/,ITBLIB( 4,2)/2HD /,ITBLIB( 4,3)/2H /,
1ITBLIB( 4,4)/2H /,ITBLIB( 4,5)/%2 /
C
C05 AS TYPE = 3
DATA ITBLIB( 5,1)/2HAS/,ITBLIB( 5,2)/2H /,ITBLIB( 5,3)/2H /,
1ITBLIB( 5,4)/2H /,ITBLIB( 5,5)/%3 /
C
C06 ASD TYPE = 3
DATA ITBLIB( 6,1)/2HAS/,ITBLIB( 6,2)/2HD /,ITBLIB( 6,3)/2H /,
1ITBLIB( 6,4)/2H /,ITBLIB( 6,5)/%3 /
C
C07 BC TYPE = 7
DATA ITBLIB( 7,1)/2HBC/,ITBLIB( 7,2)/2H /,ITBLIB( 7,3)/2H /,
1ITBLIB( 7,4)/2H /,ITBLIB( 7,5)/%7 /
C
C08 BF TYPE = 9
DATA ITBLIB( 8,1)/2HBF/,ITBLIB( 8,2)/2H /,ITBLIB( 8,3)/2H /,
1ITBLIB( 8,4)/2H /,ITBLIB( 8,5)/%11 /
C
C09 BM TYPE = 7
DATA ITBLIB( 9,1)/2HBM/,ITBLIB( 9,2)/2H /,ITBLIB( 9,3)/2H /,
1ITBLIB( 9,4)/2H /,ITBLIB( 9,5)/%7 /
C
C10 BNC TYPE = 7
DATA ITBLIB(10,1)/2HBN/,ITBLIB(10,2)/2HC /,ITBLIB(10,3)/2H /,
1ITBLIB(10,4)/2H /,ITBLIB(10,5)/%7 /
C
C11 BNO TYPE = 7
DATA ITBLIB(11,1)/2HBN/,ITBLIB(11,2)/2HO /,ITBLIB(11,3)/2H /,
1ITBLIB(11,4)/2H /,ITBLIB(11,5)/%7 /
C
C12 BNZ TYPE = 7
DATA ITBLIB(12,1)/2HBN/,ITBLIB(12,2)/2HZ /,ITBLIB(12,3)/2H /,
1ITBLIB(12,4)/2H /,ITBLIB(12,5)/%7 /
C
C13 BP TYPE = 7
DATA ITBLIB(13,1)/2HBP/,ITBLIB(13,2)/2H /,ITBLIB(13,3)/2H /,
1ITBLIB(13,4)/2H /,ITBLIB(13,5)/%7 /
C
C14 BR TYPE = 7
DATA ITBLIB(14,1)/2HBR/,ITBLIB(14,2)/2H /,ITBLIB(14,3)/2H /,
1ITBLIB(14,4)/2H /,ITBLIB(14,5)/%7 /
C
C15 BR7 TYPE = 7
DATA ITBLIB(15,1)/2HBR/,ITBLIB(15,2)/2H7 /,ITBLIB(15,3)/2H /,
1ITBLIB(15,4)/2H /,ITBLIB(15,5)/%7 /
C
C16 BT TYPE = 8
DATA ITBLIB(16,1)/2HBT/,ITBLIB(16,2)/2H /,ITBLIB(16,3)/2H /,
1ITBLIB(16,4)/2H /,ITBLIB(16,5)/%10 /
C
C17 BZ TYPE = 7
DATA ITBLIB(17,1)/2HBZ/,ITBLIB(17,2)/2H /,ITBLIB(17,3)/2H /,
1ITBLIB(17,4)/2H /,ITBLIB(17,5)/%7 /
C
C18 CI TYPE = 6
DATA ITBLIB(18,1)/2HCI/,ITBLIB(18,2)/2H /,ITBLIB(18,3)/2H /,
1ITBLIB(18,4)/2H /,ITBLIB(18,5)/%6 /
C
C
C19 CLR TYPE = 2
DATA ITBLIB(19,1)/2HCL/,ITBLIB(19,2)/2HR /,ITBLIB(19,3)/2H /,
1 ITBLIB(19,4)/2H /,ITBLIB(19,5)/%2 /
C
C20 CM TYPE = 2
DATA ITBLIB(20,1)/2HCM/,ITBLIB(20,2)/2H /,ITBLIB(20,3)/2H /,
1 ITBLIB(20,4)/2H /,ITBLIB(20,5)/%2 /
C
C21 COM TYPE = 2
DATA ITBLIB(21,1)/2HCO/,ITBLIB(21,2)/2HM /,ITBLIB(21,3)/2H /,
1 ITBLIB(21,4)/2H /,ITBLIB(21,5)/%2 /
C
C22 DC TYPE = 5
DATA ITBLIB(22,1)/2HDC/,ITBLIB(22,2)/2H /,ITBLIB(22,3)/2H /,
1 ITBLIB(22,4)/2H /,ITBLIB(22,5)/%5 /
C
C23 DCI TYPE = 10
DATA ITBLIB(23,1)/2HDC/,ITBLIB(23,2)/2HI /,ITBLIB(23,3)/2H /,
1 ITBLIB(23,4)/2H /,ITBLIB(23,5)/%12 /
C
C24 DI TYPE = 2
DATA ITBLIB(24,1)/2HIN/,ITBLIB(24,2)/2H /,ITBLIB(24,3)/2H /,
1 ITBLIB(24,4)/2H /,ITBLIB(24,5)/%2 /
C
C25 DS TYPE = 3
DATA ITBLIB(25,1)/2HDS/,ITBLIB(25,2)/2H /,
1 ITBLIB(25,3)/2H /,ITBLIB(25,4)/2H /,ITBLIB(25,5)/%3 /
C
C26 EI TYPE = 2
DATA ITBLIB(26,1)/2HEI/,ITBLIB(26,2)/2H /,
1 ITBLIB(26,3)/2H /,ITBLIB(26,4)/2H /,ITBLIB(26,5)/%2 /
C
C27 EJECT TYPE = 13
DATA ITBLIB(27,1)/2HEJ/,ITBLIB(27,2)/2HEC/,
1 ITBLIB(27,3)/2HT /,ITBLIB(27,4)/2H /,ITBLIB(27,5)/%15/
C
C28 END TYPE = 14
DATA ITBLIB(28,1)/2HEN/,ITBLIB(28,2)/2HD /,
1 ITBLIB(28,3)/2H /,ITBLIB(28,4)/2H /,ITBLIB(28,5)/%16/
C
C29 EQU TYPE = 12
DATA ITBLIB(29,1)/2HEQ/,ITBLIB(29,2)/2HU /,
1 ITBLIB(29,3)/2H /,ITBLIB(29,4)/2H /,ITBLIB(29,5)/%14/
C
C30 IN TYPE = 6
DATA ITBLIB(30,1)/2HIN/,ITBLIB(30,2)/2H /,
1 ITBL(30,3)/2H /,ITBLIB(30,4)/2H /,ITBLIB(30,5)/%6 /
C
C31 INC TYPE = 2
DATA ITBLIB(31,1)/2HIN/,ITBLIB(31,2)/2HC /,ITBLIB(31,3)/2H /,
1 ITBLIB(31,4)/2H /,ITBLIB(31,5)/%2 /
C
C32 INS TYPE = 4
DATA ITBLIB(32,1)/2HIN/,ITBLIB(32,2)/2HS /,ITBLIB(32,3)/2H /,
1 ITBLIB(32,4)/2H /,ITBLIB(32,5)/%4 /
C
C33 JMP TYPE = 10
DATA ITBLIB(33,1)/2HJM/,ITBLIB(33,2)/2HP /,ITBLIB(33,3)/2H /,
1 ITBLIB(33,4)/2H /,ITBLIB(33,5)/%12 /
C
C34 LI TYPE = 6
DATA ITBLIB(34,1)/2HLI/,ITBLIB(34,2)/2H /,ITBLIB(34,3)/2H /,
1 ITBLIB(33,4)/2H /,ITBLIB(34,5)/%6 /
C
C35 LIS TYPE = 4
DATA ITBLIB(35,1)/2HLI/,ITBLIB(35,2)/2HS /,ITBLIB(35,3)/2H /,
1 ITBLIB(35,4)/2H /,ITBLIB(35,5)/%4 /
C
C36 LISL TYPE = 15
DATA ITBLIB(36,1)/2HLI/,ITBLIB(36,2)/2HSL/,ITBLIB(36,3)/2H /,
1 ITBLIB(36,4)/2H /,ITBLIB(36,5)/%17 /
C
C37 LISU TYPE = 15
DATA ITBLIB(37,1)/2HLI/,ITBLIB(37,2)/2HSU/,ITBLIB(37,3)/2H /,
1 ITBLIB(37,4)/2H /,ITBLIB(37,5)/%17 /
C
C38 LM TYPE = 2
DATA ITBLIB(38,1)/2HLM/,ITBLIB(38,2)/2H /,ITBLIB(38,3)/2H /,
1 ITBLIB(38,4)/2H /,ITBLIB(38,5)/%2 /
C
C39 LNK TYPE = 2
DATA ITBLIB(39,1)/2HLN/,ITBLIB(39,2)/2HK /,ITBLIB(39,3)/2H /,
1 ITBLIB(39,4)/2H /,ITBLIB(39,5)/%2 /
C
C40 LR TYPE = 1
DATA ITBLIB(40,1)/2HLR/,ITBLIB(40,2)/2H /,ITBLIB(40,3)/2H /,
1 ITBLIB(40,4)/2H /,ITBLIB(40,5)/%1 /
C
C41 NI TYPE = 6
DATA ITBLIB(41,1)/2HNI/,ITBLIB(41,2)/2H /,ITBLIB(41,3)/2H /,
1 ITBLIB(41,4)/2H /,ITBLIB(41,5)/%6 /
C
C42 NM TYPE = 2
DATA ITBLIB(42,1)/2HNM/,ITBLIB(42,2)/2H /,ITBLIB(42,3)/2H /,
1 ITBLIB(42,4)/2H /,ITBLIB(42,5)/%2 /
C
C43 NOP TYPE = 2
DATA ITBLIB(43,1)/2HNO/,ITBLIB(43,2)/2HP /,ITBLIB(43,3)/2H /,
1 ITBLIB(43,4)/2H /,ITBLIB(43,5)/%2 /
C
C44 NS TYPE = 3
DATA ITBLIB(44,1)/2HNS/,ITBLIB(44,2)/2H /,ITBLIB(44,3)/2H /,
1 ITBLIB(44,4)/2H /,ITBLIB(44,5)/%3 /
C
C45 OI TYPE = 6
DATA ITBLIB(45,1)/2HOI/,ITBLIB(45,2)/2H /,ITBLIB(45,3)/2H /,
1 ITBLIB(45,4)/2H /,ITBLIB(45,5)/%6 /
C
C46 OM TYPE = 2
DATA ITBLIB(46,1)/2HOM/,ITBLIB(46,2)/2H /,ITBLIB(46,3)/2H /,
1 ITBLIB(46,4)/2H /,ITBLIB(46,5)/%2 /
C
C47 ORG TYPE = 11
DATA ITBLIB(47,1)/2HOR/,ITBLIB(47,2)/2HG /,ITBLIB(47,3)/2H /,
1 ITBLIB(47,4)/2H /,ITBLIB(47,5)/%12 /
C
C48 OUT
DATA ITBLIB(48,1)/2HOU/,ITBLIB(48,2)/2HT /,ITBLIB(48,3)/2H /,
1 ITBLIB(48,4)/2H /,ITBLIB(48,5)/%6 /
C
C49 OUTS TYPE = 4
DATA ITBLIB(49,1)/2HOU/,ITBLIB(49,2)/2HTS/,ITBLIB(49,/2H /,
1 ITBLIB(49,4)/2H /,ITBLIB(49,5)/%4 /
C
C50 PI TYPE = 10
DATA ITBLIB(50,1)/2HPI/,ITBLIB(50,2)/2H /,ITBLIB(50,3)/2H /,
1 ITBLIB(50,4)/2H /,ITBLIB(50,5)/%12 /
C
C51 PK TYPE = 2
DATA ITBLIB(51,1)/2HPK/,ITBLIB(51,2)/2H /,ITBLIB(51,3)/2H /,
1 ITBLIB(51,4)/2H /,ITBLIB(51,5)/%2 /
C
C52 POP TYPE = 2
DATA ITBLIB(52,1)/2HPO/,ITBLIB(52,2)/2HP /,ITBLIB(52,3)/2H /,
1 ITBLIB(52,4)/2H /,ITBLIB(52,5)/%2 /
C
C5& PRINT
DATA ITBLIB(53,1)/2HPR/,ITBLIB(53,2)/2HIN/,ITBLIB(53,3)/2H /,
1 ITBLIB(53,4)/2H /,ITBLIB(53,5)/%15 /
C
C54 PUNCH
DATA ITBLIB(54,1)/2HPU/,ITBLIB(54,2)/2HNC/,ITBLIB(54,3)/2H /,
1 ITBLIB(54,4)/2H /,ITBLIB(54,5)/%15 /
C
C55 SL TYPE = 16
DATA ITBLIB(55,1)/2HSL/,ITBLIB(55,2)/2H /,ITBLIB(55,3)/2H /,
1 ITBLIB(55,4)/2H /,ITBLIB(55,5)/%20 /
C
C56 SR TYPE = 16
DATA ITBLIB(56,1)/2HSR/,ITBLIB(56,2)/2H /,ITBLIB(56,3)/2H /,
1 ITBLIB(56,4)/2H /,ITBLIB(56,5)/%20 /
C
C57 ST TYPE = 2
DATA ITBLIB(57,1)/2HST/,ITBLIB(57,2)/2H /,ITBLIB(57,3)/2H /,
1 ITBLIB(57,4)/2H /,ITBLIB(57,5)/%2 /
C
C58 TITLE TYPE = 13
DATA ITBLIB(58,1)/2HTI/,ITBLIB(58,2)/2HTL/,ITBLIB(58,3)/2H /,
1 ITBLIB(58,4)/2H /,ITBLIB(58,5)/%15 /
C
C59 XDC TYPE = 2
DATA ITBLIB(59,1)/2HXD/,ITBLIB(59,2)/2HC /,ITBLIB(59,3)/2H /,
1 ITBLIB(59,4)/2H /,ITBLIB(59,5)/%2 /
C
C60 XI TYPE = 6
DATA ITBLIB(60,1)/2HXI/,ITBLIB(60,2)/2H /,ITBLIB(60,3)/2H /,
1 ITBLIB(60,4)/2H /,ITBLIB(60,5)/%6 /
C
C61 XM TYPE = 2
DATA ITBLIB(61,1)/2HXM/,ITBLIB(61,2)/2H /,ITBLIB(61,3)/2H /,
1 ITBLIB(61,4)/2H /,ITBLIB(61,5)/%2 /
C
C62 XS TYPE = 3
DATA ITBLIB(62,1)/2HXS/,ITBLIB(62,2)/2H /,ITBLIB(62,3)/2H /,
1 ITBLIB(62,4)/2H /,ITBLIB(62,5)/%3 /
C
C
DO 20 I=1,26
20 JETAB(I) = LETAB(I)
LAST = 1
LINK = 1
IRELR = 1
MAXSYMBOLS = 800
DO 40 I=1,62
DO 40 J=1,5
40 JTBLIB(I,J) = ITBLIB(I,J)
C
RETURN
END
FUNCTION ICHAR(I)
C
CCCCC CHAR ROUTINE
C
C
C
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1 ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,IRL,
2 IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,PWORD,
3 PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4 EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5 LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
C
C
CCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR, PSORT,PLINEAR,PSTACK,
1 P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,OPERANDTYPE,TERM,
2 BYTEPNTR,EXTNMBR, EXTCOUNT, RELTYPE, PRELATIVE,BYTE,EXT,EQU,
3 HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3
C
INTEGER SYMBOLTABLE,SYMBOL,SFILE,OFILE,STACK,WORD,RMB,XTAB
C
C
C
CCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST, LISTSYMBOL, MEMORY, TAPE, FOUND, LISTON,
1 DIRECTIVE, EXTFOUND, RELFOUND, DEFERRED, ABSOLUTE, BEFOREREL,
2 EXTLIST, XREF, ABORTED,ITRAN
LOGICAL PASS2SW,DEFNSYMBOL
C
C
C
C
CCCCC EQUATE STATEMENT
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA ,LETAB(2)),(IBLKB ,LETAB( 3)),(IASTRIK,LETAB( 4)),
3 (ISPMA ,LETAB(5)),(ISPDIR,LETAB( 6)),(ISPEXT ,LETAB( 7)),
4 (ISPDIX ,LETAB(8)),(IPLUS ,LETAB( 9)),(ICOMMA ,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15))
C
EQUIVALENCE (ICOMAR,LETAB(19)),
1 (ICOMAT ,LETAB(20)),(ICOMAA,LETAB(21)),(ICOMAE ,LETAB(22)),
2 (ICOMAC ,LETAB(23)),(ICOMAK,LETAB(24)),(ILFAST ,LETAB(25))
C
J1 = (I+1)/2
JJ = LINE(J1)
C
ITRAN = BOOL(I) .AND. %1L
II = INT(ITRAN)
IF( II .EQ. 0 ) GO TO 20
C ROTE LINE(JJ)
JK[8:8] = JJ[0:8]
JK[0:8] = JJ[8:8]
GO TO 30
C
20 JK = JJ
C
30 ITRAN = BOOL(JK) .AND. %377L
C
JM = INT(ITRAN)
IF( JM .LT. 48 ) GO TO 35
IF( JM .GT. 57 ) GO TO 35
GO TO 38
C
35 ITRAN = ITRAN .OR. %020000L
JM = INT(ITRAN)
C
ICHAR = JM
C
C
RETURN
END
SUBROUTINE IGETSYMBOL
C
CCCCCC GET SYMBOL
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,
2IRL,IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
3PWORD,PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
CCCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR,PSORT,PLINEAR,
1 PSTACK,P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,TERM,
2 OPERANDTYPE,BYTEPNTR,EXTNMBR,EXTCOUNT,RELTYPE,PRELATIVE,
3 BYTE,EXT,EQU,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
4 SYMBOLTABLE,SYMBOL,SFILE,OFILE,STACK,WORD,RMB,AB
C
C
CCCCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,
1 DIRECTIVE,EXTFOUND,RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,
2 EXTLIST,XREF,ABORTED,ITRAN
LOGICAL PASS2SW,DEFNSYMBOL
C
CCCCCC EQUATE STATEMENT
C
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA,LETAB(2)),(IBLKB,LETAB(3)),(IASTRIK,LETAB(4)),
3 (ISPMA,LETAB(5)),(ISPDIR,LETAB(6)),(ISPEXT,LETAB(7)),
4 (ISPDIX,LETAB(8)),(IPLUS,LETAB(9)),(ICOMMA,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15)),
7 (ICOMAR,LETAB(19)),(ICOMAT,LETAB(20)),(ICOMAA,LETAB(21)),
8 (ICOMAE,LETAB(22)),(ICOMAC,LETAB(23)),(ICOMAK,LETAB(25)),
9 (ILFAST,LETAB(25))
C
C
DO 100 I=1,3
100 SYMBOL(I) = IBLANK
C
DO 1000 I=2,7
C
J = ICHAR(PCHAR)
IF(J .EQ. IBLANK .OR. J .EQ. ICOMMA ) RETURN
IF(J .EQ. IPLUS .OR. J .EQ. IMINUS ) RETURN
IF(J .EQ. IASTRIK ) RETURN
C
ITRAN = BOOL(I) .AND. %1L
IF( INT(ITRAN) .NE. 0) GO TO 400
C
JK = J
J[8:8] = JK[0:8]
J[0:8] = JK[8:8]
C
JL = I/2
ITRAN =BOOL(J) .OR. (BOOL(SYMBOL(JL)) .AND. %377L)
SYMBOL(JL) = INT(ITRAN)
GO TO 500
C
400 JL = I/2
ITRAN = BOOL(J) .AND. %377L
ITRAN = ITRAN .OR. (BOOL(SYMBOL(JL)) .AND. %177400L)
SYMBOL(JL) = INT(ITRAN)
C
500 PCHAR = PCHAR + 1
C
1000 CONTINUE
C
RETURN
END
FUNCTION ISYMBOLTYPE (PNTR)
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,
1LINK,ITYPE,ILENGTH,IDUMMYCMN(48),
2 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
3 LETAB(26),ITBLIB(62,5),
4 ITYP1(162),T,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR,SYMBOLTABLE,
1 SYMBOL,SFILE,OFILE,BYTE,STACK,WORD,EXT,EQU,RMB,IKDAT(3),PNTR
INTEGER XTAB
C
LOGICAL PASS2SW,DEFNSYMBOL
C
C
C
CCCCCCC LOCAL DATA STATEMENT
C
C
IKDAT(1) = 8224
IKDAT(2) = 8274
IKDAT(3) = 81
C
J = SYMBOLTABLE(PNTR,7)
IF( J .NE. 0 ) GO TO 50
ISYMBOLTYPE = IKDAT(1)
RETURN
C
50 IF( J .NE. 1 ) GO TO 100
ISYMBOLTYPE = IKDAT(2)
RETURN
C
100 ISYMBOLTYPE = IKDAT(3)
RETURN
C
END
SUBROUTINE XADDTOSYMT (IERR)
C
C
CCCCCCCC SUBROUTINE XADDTOSYMT (IERR)
C
C
C
C
C
CCCC COMMON AREA
C
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1 ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,IRL,
2 IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,PWORD,
3 PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4 EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5 LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
C
C
CCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR, PSORT,PLINEAR,PSTACK,
1 P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,OPERANDTYPE,TERM,
2 BYTEPNTR,EXTNMBR, EXTCOUNT, RELTYPE, PRELATIVE,BYTE,EXT,EQU,
3 ORG,RMB,FCB,FDB,CMN,REL,UNDEFINED,EEQU,EEXT,RRMB,
4 HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3
C
INTEGER SYMBOLTABLE, SYMBOL, SFILE,OFILE,STACK,WORD,
1 MXSYMBOL(3),XTAB
C
C
C
CCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST, LISTSYMBOL, MEMORY, TAPE, FOUND, LISTON,
1 DIRECTIVE, EXTFOUND, RELFOUND, DEFERRED, ABSOLUTE, BEFOREREL,
2 EXTLIST, XREF, ABORTED,ITRAN
C
LOGICAL PASS2SW,DEFNSYMBOL
C
C
CCCCC EQUATE STATEMENT
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA ,LETAB(2)),(IBLKB ,LETAB( 3)),(IASTRIK,LETAB( 4)),
3 (ISPMA ,LETAB(5)),(ISPDIR,LETAB( 6)),(ISPEXT ,LETAB( 7)),
4 (ISPDIX ,LETAB(8)),(IPLUS ,LETAB( 9)),(ICOMMA ,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15))
C
EQUIVALENCE (ICOMAR,LETAB(19)),
1 (ICOMAT ,LETAB(20)),(ICOMAA,LETAB(21)),(ICOMAE ,LETAB(22)),
2 (ICOMAC ,LETAB(23)),(ICOMAK,LETAB(24)),(ILFAST ,LETAB(25))
C
DIMENSION ISYMBOL(3)
C
C
IERR = 0
C
IF(PSYMBOL .LE. MAXSYMBOLS) GO TO 70
C
WRITE(IPRINT,20) LINECOUNT
20 FORMAT(" ##### SYMBOL TABLE OVERFLOW IN LINE ",I5)
IERR = 1
RETURN
C
70 DO 80 I=1,3
80 ISYMBOL(I) = SYMBOL(I)
C
IF( PA2SW ) GO TO 500
IF(PSYMBOL .EQ. 0) GO TO 300
C
J = ISYMBOLSEARCH( ISYMBOL(1) )
C
IF( .NOT.FOUND ) GO TO 300
SYMBOLTABLE(LAST,4) = J + 1
RETURN
C
CCCCCCC START
C
300 PSYMBOL = PSYMBOL + 1
SYMBOLTABLE(LAST,LINK) = PSYMBOL
C
DO 310 I=1,3
310 SYMBOLTABLE(PSYMBOL,I) = SYMBOL(I)
SYMBOLTABLE(PSYMBOL,4) = 1
SYMBOLTABLE(PSYMBOL,5) = 0
SYMBOLTABLE(PSYMBOL,6) = 0
RETURN
C
500 J = ISYMBOLSEARCH (ISYMBOL(1))
IF( .NOT.DEFNSYMBOL ) GO TO 510
XTAB(J) = LINECOUNT
RETURN
C
510 J = J + 1
520 IF(XTAB(J) .EQ. 0) GO TO 540
C
J = J + 1
GO TO 520
540 XTAB(J) = LINECOUNT
RETURN
C
END
SUBROUTINE INITXTAB(IERR)
C
C
CCCCCCCCCCC SUBROUTINE INITXTAB(IERR)
C
C
C
C
C
CCCC COMMON AREA
C
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1 ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,IRL,
2 IINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,PWORD,
3 PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4 EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5 LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
C
C
CCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR, PSORT,PLINEAR,PSTACK,
1 P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,OPERANDTYPE,TERM,
2 BYTEPNTR,EXTNMBR, EXTCOUNT, RELTYPE, PRELATIVE,BYTE,EXT,EQU,
3 ORG,RMB,FCB,FDB,CMN,REL,UNDEFINED,EEQU,EEXT,RRMB,
4 HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3
C
INTEGER SYMBOLTABLE, SYMBOL, SFILE,OFILE,STACK,WORD,
1 MXSYMBOL(3),XTAB
C
C
C
CCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST, LISTSYMBOL, MEMORY, TAPE, FOUND, LISTON,
1 DIRECTIVE, EXTFOUND, RELFOUND, DEFERRED, ABSOLUTE, BEFOREREL,
2 EXTLIST, XREF, ABORTED,ITRAN
LOGICAL PASS2SW,DEFNSYMBOL
C
C
C
CCCCC EQUATE STATEMENT
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA ,LETAB(2)),(IBLKB ,LETAB( 3)),(IASTRIK,LETAB( 4)),
3 (ISPMA ,LETAB(5)),(ISPDIR,LETAB( 6)),(ISPEXT ,LETAB( 7)),
4 (ISPDIX ,LETAB(8)),(IPLUS ,LETAB( 9)),(ICOMMA ,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15))
C
EQUIVALENCE (ICOMAR,LETAB(19)),
1 (ICOMAT ,LETAB(20)),(ICOMAA,LETAB(21)),(ICOMAE ,LETAB(22)),
2 (ICOMAC ,LETAB(23)),(ICOMAK,LETAB(24)),(ILFAST ,LETAB(25))
C
DIMENSION ISYMBOL(3)
C
C
IERR = 0
C
DO 100 I=1,MAXTAB
100 XTAB(I) = 0
C
J = 1
JJ = PSYMBOL + 1
C
DO 200 I=1,JJ
NJ = SYMBOLTABLE(I,4)
SYMBOLTABLE(I,4) = J
C
J = NJ + J
IF(J .GT. MAXTAB) GO TO 240
200 CONTINUE
RETURN
C
240 I = 1
IERR = 1
WRITE(IPRINT,260)MAXTAB,J
260 FORMAT(" ####### XREF TABLE OVERFLOW IN MAXTAB ",I5,
1 " REQUIRED SIZE = ",I5 )
RETURN
C
END
FUNCTION ISYMBOLSEARCH (ISYMBOL)
C
CCCCC SYMBOL SEARCH
C
C
C
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1 ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,IRL,
2 IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,PWORD,
3 PSECT,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4 EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5 LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOXTAB(6000),SFILE(3),BYTE(3)
C
C
C
CCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR, PSORT,PLINEAR,PSTACK,
1 P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,OPERANDTYPE,TERM,
2 BYTEPNTR,EXTNMBR, EXTCOUNT, RELTYPE, PRELATIVE,BYTE,EXT,EQU,
3 HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3
C
INTEGER SYMBOLTABLE,SYMBOL,SFILE,OFILE,STACK,WORD,RMB,XTAB
C
C
C
CCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST, LISTSYMBOL, MEMORY, TAPE, FOUND, LISTON,
1 DIRECTIVE, EXTFOUND, RELFOUND, DEFERRED, ABSOLUTE, BEFOREREL,
2 EXTLIST, XREF, ABORTED
LOGICAL PASS2SW,DEFNSYMBOL
C
C
C
C
CCCCC EQUATE STATEMENT
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA ,LETAB(2)),(IBLKB ,LETAB( 3)),(IASTRIK,LETAB( 4)),
3 (ISPMA ,LETAB(5)),(ISPDIR,LETAB( 6)),(ISPEXT ,LETAB( 7)),
4 (ISPDIX ,LETAB(8)),(IPLUS ,LETAB( 9)),(ICOMMA ,LETAB0)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15))
C
EQUIVALENCE (ICOMAR,LETAB(19)),
1 (ICOMAT ,LETAB(20)),(ICOMAA,LETAB(21)),(ICOMAE ,LETAB(22)),
2 (ICOMAC ,LETAB(23)),(ICOMAK,LETAB(24)),(ILFAST ,LETAB(25))
C
DIMENSION ISYMBOL(3)
C
C
C
C
C
FOUND = .FALSE.
N = 1
C
C
100 LAST = N
DO 140 I=1,3
N1 = ISYMBOL(I) - SYMBOLTABLE(LAST,I)
IF( N1 .LT. 0 ) GO TO 160
IF( N1 .GT. 0 ) GO TO 180
140 CONTINUE
C
FOUND = .TRUE.
ISYMBOLSEARCH = SYMBOLTABLE(LAST,4)
EXTNMBR = SYMBOLTABLE (LAST,7)
RETURN
C
160 LINK = 5
GO TO 200
180INK = 6
C
200 N = SYMBOLTABLE(LAST,LINK)
IF( N .NE. 0 ) GO TO 100
C
C 160 CONTINUE
C 180 CONTINUE
C 200 N = N + 1
C IF(N .LE. PSYMBOL ) GO TO 100
C
RETURN
END
SUBROUTINE FINSTR
C
CCCCCC GET SYMBOL
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,
2IRL,IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
3PWORD,PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
CCCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR,PSORT,PLINEAR,
1 PSTACK,P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,TERM,
2 OPERANDTYPE,BYTEPNTR,EXTNMBR,EXTCOUNT,RELTYPE,PRELATIVE,
3 BYTE,EXT,EQU,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
4 SYMBOLTABLE,SYMBOL,SFILE,OFILE,STACK,WORD,RMB,XTAB
C
C
CCCCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,
1 DIRECTIVE,EXTFOUND,RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,
2 EXTLIST,XREF,ABORTED,ITRAN
LOGICAL PASS2SW,DEFNSYMBOL
C
CCCCCC EQUATE STATEMENT
C
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA,LETAB(2)),(IBLKB,LETAB(3)),(IASTRIK,LETAB(4)),
3 (ISPMA,LETAB(5)),(ISPDIR,LETAB(6)),(ISPEXT,LETAB(7)),
4 (ISPDIX,LETAB(8)),(IPLUS,LETAB(9)),(ICOMMA,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15)),
7 (ICOMAR,LETAB(19)),(ICOMAT,LETAB(20)),(ICOMAA,LETAB(21)),
8 (ICOMAE,LETAB(22)),(ICOMAC,LETAB(23)),(ICOMAK,LETAB(25)),
9 (ILFAST,LETAB(25))
C
C
DO 100 I=1,3
100 BYTE(I) = IBLANK
INDX = 1
C
DO 1000 I=2,30
C
J = ICHAR(PCHAR)
IF(J .NE. IBLANK) GO TO 200
IF(INDX .āE. 1) RETURN
GO TO 500
C
200 INDX = INDX + 1
C
ITRAN = BOOL(INDX) .AND. %1L
IF( INT(ITRAN) .NE. 0) GO TO 400
C
JK = J
J[8:8] = JK[0:8]
J:8] = JK[8:8]
C
JL = INDX/2
ITRAN =BOOL(J) .OR. (BOOL(BYTE(JL)) .AND. %377L)
BYTE(JL) = INT(ITRAN)
GO TO 500
C
400 JL = INDX/2
ITRAN = BOOL(J) .AND. %377L
ITRAN = ITRAN .OR. (BOOL(BYTE(JL)) .AND. %177400L)
BYTE(JL) = INT(ITRAN)
C
500 PCHAR = PCHAR + 1
C
1000 CONTINUE
C
RETURN
END
SUBROUTINE IGETOPSYMB (JFOUND)
C
CCCCCC GET SYMBOL
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,
2IRL,IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
3PWORD,PSECTOR,LOADEDBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL(3),STACK(800),MAXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAXTAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
CCCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOLCHAR,PSORT,PLINEAR,
1 PSTACK,P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,TERM,
2 OPERANDTYPE,BYTEPNTR,EXTNMBR,EXTCOUNT,RELTYPE,PRELATIVE,
3 BYTE,EXT,EQU,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
4 SYMBOLTABLE,SYMBOL,SFILE,OFILE,STACK,WORD,RMB,XTAB
C
C
CCCCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,
1 DIRECTIVE,EXTFOUND,RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,
2 EXTLIST,XREF,ABORTED,ITRAN
LOGICAL PASS2SW,DEFNSYMBOL
C
CCCCCC EQUATE STATEMENT
C
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA,LETAB(2)),(IBLKB,LETAB(3)),(IASTRIK,LETAB(4)),
3 (ISPMA,LETAB(5)),(ISPDIR,LETAB(6)),(ISPEXT,LETAB(7)),
4 (ISPDIX,LETAB(8)),(IPLUS,LETAB(9)),(ICOMMA,LETAB(10)),
5 (IMINUS,LETAB(11)),ATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15)),
7 (ICOMAR,LETAB(19)),(ICOMAT,LETAB(20)),(ICOMAA,LETAB(21)),
8 (ICOMAE,LETAB(22)),(ICOMAC,LETAB(23)),(ICOMAK,LETAB(25)),
9 (ILFAST,LETAB(25))
C
DATA ICOLON/2H :/
C
C
C
C
ICH =8264
ICB = 8258
C
C JFOUND = 0, NOT FOUND
C = 1, FOUND
C
JFOUND = 0
C
DO 30 I=1,3
30 SYMBOL(I) = IBLANK
C
INDX = 1
IBLKCNT = 1
C
DO 1000 I=2,50
C
J = ICHAR(PCHAR)
IF(J .EQ. ICOLON) RETURN
IF(J .NE. IBLANK) GO TO 200
IF(INDX .EQ. 1) GO TO 500
IF(ITYPE .NE. 5) RETURN
JFOUND = 2
RETURN
C
C
CCCCC CHECK H"XX" & "+" & "-"
C
200 IF(INDX .NE. 1 ) GO TO 300
C
IF(J .EQ. IASTRIK) RETURN
IF((J .EQ. ICH) .OR. (J .EQ. ICB)) GO TO 330
IF((J .GT. 47) .AND. (J .LT. 58)) GO TO 450
IF(J .EQ. ICOMMA) GO TO 500
C
300 INDX = INDX + 1
JFOUND = 1
IF((J .EQ. IPLUS) .OR. (J .EQ. IMINUS)) GO TO 320
GO TO 350
320 PCHAR = PCHAR + 1
RETURN
C
330 PCHAR = PCHAR + 1
J = ICHAR(PCHAR)
IF(J .EQ. IAPOSTR) RETURN
C
PCHAR = PCHAR - 1
J = ICHAR(PCHAR)
GO TO 300
C
350 ITRAN = BOOL(INDX) .AND. %1L
IF(INT(ITRAN) .NE. 0) GO TO 400
C
JK = J
J[8:8] = JK[0:8]
J[0:8] = JK[8:8]
C
JL = INDX/2
ITRAN = BOOL(J) .OR. (BOOL(SYMBOL(JL)) .AND. %377L)
SYMBOL(JL) = INT(ITRAN)
GO TO 500
C
400 JL = INDX/2
ITRAN = BOOL(J) .AND. %377L
ITRAN = ITRAN .OR. (BOOL(SYMBOL(JL)) .AND. %177400L)
SYMBOL(JL) = INT(ITRAN)
GO TO 500
C
450 PCHAR = PCHAR + 1
J = ICHAR(PCHAR)
IF(J .EQ. IBLANK) RETURN
PCHAR = PCHAR - 1
C
C
500 PCHAR = PCHAR + 1
C
IBLKCNT = IBLKCNT + 1
IF(IBLKCNT .GE. 20) RETURN
C
1000 CONTINUE
C
RETURN
END
SUBROUTINE INSTRT
C
CCCCCC GET SYMBOL
C
COMMON LINECOUNT,ERRORCOUNT,PSYMBOL,PCHAR,LAST,LINK,
1ITYPE,ILENGTH,LINELENGTH,IERROR,INST,PSORT,PLINEAR,PSTACK,IN,
2IRL,IPRINT,P2,P3,P4,P5,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
3PWORD,PSECTOR,LOADBYTES,TERMTYPE,EXPTYPE,OPERANDTYPE,BYTEPNTR,
4EXTNMBR,EXTCOUNT,RELTYPE,IVALUE,ILAST,ILINK,PRELATIVE,ENDOFFILE,
5LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,DIRECTIVE,EXTFOUND,
6 RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,EXTLIST,XREF,ABORTED,
7 LINE(30),SYMBOLTABLE(800,7),SYMBOL),STACK(800)AXSYMBOLS,
8 LETAB(26),ITBLIB(62,5),ITYP1(162),EXT,EQU,RMB,IRELR
COMMON MAAB,PASS2SW,DEFNSYMBOL,XTAB(6000),SFILE(3),BYTE(3)
C
CCCCC INTEGER
C
INTEGER PROGCOUNT,ERRORCOUNT,PSYMBOL,PCHAR,PSORT,PLINEAR,
1 PSTACK,P2,P3,P4,P5,PWORD,PSECTOR,TERMTYPE,EXPTYPE,TERM,
2 OPERANDTYPE,BYTEPNTR,EXTNMBR,EXTCOUNT,RELTYPE,PRELATIVE,
3 BYTE,EXT,EQU,HEXP1,HEXP2,HEXBYTE1,HEXBYTE2,HEXBYTE3,
4 SYMBOLBLE,SYMBOL,SFILE,OFILE,STACK,WORD,RMB,XB
C
C
CCCCCC LOGICAL
C
LOGICAL ENDOFFILE,LIST,LISTSYMBOL,MEMORY,TAPE,FOUND,LISTON,
1 DIRECTIVE,EXTFOUND,RELFOUND,DEFERRED,ABSOLUTE,BEFOREREL,
2 EXTLIST,XREF,ABORTED,ITRAN
LOGICAL PASS2SW,DEFNSYMBOL
C
CCCCCC EQUATE STATEMENT
C
EQUIVALENCE (ICOMAL,LETAB(18)),
1 (IBLANK,LETAB(1)),(IASMB1,LETAB(16)),(IASMB2,LETAB(17)),
2 (IBLKA,LETAB(2)),(IBLKB,LETAB(3)),(IASTRIK,LETAB(4)),
3 (ISPMA,LETAB(5)),(ISPDIR,LETAB(6)),(ISPEXT,LETAB(7)),
4 (ISPDIX,LETAB(8)),(IPLUS,TAB(9)),(ICOMMA,LETAB(10)),
5 (IMINUS,LETAB(11)),(IATAND,LETAB(12)),(IAPOSTR,LETAB(13)),
6 (IGREATR,LETAB(14)),(ILESTN,LETAB(15)),
7 (ICOMAR,LETAB(19)),(ICOMAT,LETAB(20)),(ICOMAA,LETAB(21)),
8 (ICOMAE,LETAB(22)),(ICOMAC,LETAB(23)),(ICOMAK,LETAB(25)),
9 (ILFAST,LETAB(25))
C
C
CALL FINSTR
C
CCCC BYTE(I) = OP CODE
C
C FIND INST TYPE
C
IF(BYTE(1) .LT. ITBLIB(31,1)) GO TO 100
IF(BYTE(1) .GT. ITBLIB(31,1)) GO TO 30
IF(BYTE(2) .LE. ITBLIB(31,2)) GO TO 100
C
30 DO 40 I=32,62
IF(BYTE(1) .NE. ITBLIB(I,1)) GO TO 40
IF(BYTE(2) .NE. ITBLIB(I,2)) GO TO 40
ITYPE = ITBLIB(I,5)
GO TO 200
C
40 CONTINUE
C
50 WRITE(IPRINT,60) LINECOUNT,(BYTE(I1),I1=1,3)
60 FORMAT(" NO MATCH IN INSTRUCTION TYPE. LINE ",I5,2X,3A2)
RETURN
C
100 DO 130 I=1,31
IF(BYTE(1) .NE. ITBLIB(I,1)) GO TO 130
IF(BYTE(2) .NE. ITBLIB(I,2)) GO TO 130
ITYPE = ITBLIB(I,5)
GO TO 200
C
130 CONTINUE
GO TO 50
C
200 GO TO (1100,1200,1300,1400,1500,1600,1700,1800,1900,
1 2000,2100,2200,2300,2400,2500,2600),ITYPE
C
CCC TYPE = 1, LR
C
1100 RETURN
C
CCC TYPE = 2, COM,DI,EI,INC,LM,LNK,NM,NOP,OM,PK,POP,ST,XM
C
1200 RETURN
C
CCC TYPE = 3, AS,ASD,DS,NS,XS
C
1300 RETURN
C
CCC TYPE = 4, INS,LIS,OUTS
C
1400 GO TO 1550
C
CCC TYPE = 5, DC
C
1500 CALL IGETOPSYMB(JFOUND)
IF(JFOUND .EQ. 0) RETURN
DEFNSYMBOL = .FALSE.
CALL XADDTOSYMT(IERR)
C
IF(JFOUND .EQ. 2) RETURN
C
C
1550 CALL IGETOPSYMB(JFOUND)
IF(JFOUND .EQ. 0) RETURN
DEFNSYMBOL = .FALSE.
CALL XADDTOSYMT(IERR)
RETURN
C
CCC TYPE = 6, AI,CI,IN,LI,NI,OI,OUT,XI
C
1600 RETURN
C
CCC TYPE = 7, BC,BM,BNC,BNO,BNZ,BP,BR,BR7,BZ
C
1700 GO TO 1550
C
CCC TYPE = 8, BT
C
1800 RETURN
C
CCC TYPE = 9, BF
C
1900 RETURN
C
CCC TYPE = 10,DCI,JMP,PI
C
2000 GO TO 1550
C
CCC TYPE = 11, ORG
C
2100 GO TO 1550
C
CCC TYPE = 12, EQU
C
2200 GO TO 1550
C
CC TYPE = 13, EJECT,PRINT,PUNCH,TITLE
C
2300 RETURN
C
CCC TYPE = 14, END
C
2400 RETURN
C
CCC TYPE = 15, LISL,LISU
C
2500 RETURN
C
CCC TYPE = 16, SL,SR
C
2600 RETURN
END